home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / mee / csi / perftest.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-10-06  |  28.6 KB  |  777 lines
  1. VERSION 2.00
  2. Begin Form frmPerfTest 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "DB Performance Tester"
  6.    ClientHeight    =   6300
  7.    ClientLeft      =   705
  8.    ClientTop       =   2835
  9.    ClientWidth     =   9180
  10.    Height          =   6705
  11.    Left            =   645
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   6300
  14.    ScaleWidth      =   9180
  15.    Top             =   2490
  16.    Width           =   9300
  17.    Begin CommandButton cmdExit 
  18.       Caption         =   "Exit"
  19.       Height          =   495
  20.       Left            =   120
  21.       TabIndex        =   21
  22.       Top             =   1320
  23.       Width           =   1215
  24.    End
  25.    Begin CheckBox chkPassthru 
  26.       BackColor       =   &H00C0C0C0&
  27.       Caption         =   "Passthru"
  28.       Height          =   255
  29.       Left            =   7920
  30.       TabIndex        =   19
  31.       Top             =   840
  32.       Visible         =   0   'False
  33.       Width           =   1095
  34.    End
  35.    Begin TextBox txtIterations 
  36.       Height          =   285
  37.       Left            =   8850
  38.       TabIndex        =   15
  39.       Text            =   "5"
  40.       Top             =   210
  41.       Width           =   255
  42.    End
  43.    Begin Frame fraRecordset 
  44.       BackColor       =   &H00C0C0C0&
  45.       Height          =   615
  46.       Left            =   7800
  47.       TabIndex        =   14
  48.       Top             =   1200
  49.       Visible         =   0   'False
  50.       Width           =   1335
  51.       Begin OptionButton optDynaset 
  52.          BackColor       =   &H00C0C0C0&
  53.          Caption         =   "Dynaset"
  54.          Height          =   255
  55.          Left            =   105
  56.          TabIndex        =   18
  57.          Top             =   345
  58.          Width           =   1095
  59.       End
  60.       Begin OptionButton optSnapshot 
  61.          BackColor       =   &H00C0C0C0&
  62.          Caption         =   "Snapshot"
  63.          Height          =   255
  64.          Left            =   105
  65.          TabIndex        =   17
  66.          Top             =   105
  67.          Value           =   -1  'True
  68.          Width           =   1095
  69.       End
  70.    End
  71.    Begin Frame fraMethod 
  72.       BackColor       =   &H00C0C0C0&
  73.       Height          =   1215
  74.       Left            =   6045
  75.       TabIndex        =   9
  76.       Top             =   600
  77.       Width           =   1695
  78.       Begin OptionButton optMethod 
  79.          BackColor       =   &H00C0C0C0&
  80.          Caption         =   "VBSQL"
  81.          Height          =   255
  82.          Index           =   0
  83.          Left            =   135
  84.          TabIndex        =   12
  85.          Top             =   120
  86.          Value           =   -1  'True
  87.          Width           =   1215
  88.       End
  89.       Begin OptionButton optMethod 
  90.          BackColor       =   &H00C0C0C0&
  91.          Caption         =   "ODBC API"
  92.          Height          =   255
  93.          Index           =   1
  94.          Left            =   120
  95.          TabIndex        =   11
  96.          Top             =   360
  97.          Width           =   1215
  98.       End
  99.       Begin OptionButton optMethod 
  100.          BackColor       =   &H00C0C0C0&
  101.          Caption         =   "Jet (no MDB)"
  102.          Height          =   255
  103.          Index           =   2
  104.          Left            =   120
  105.          TabIndex        =   10
  106.          Top             =   600
  107.          Width           =   1455
  108.       End
  109.       Begin OptionButton optMethod 
  110.          BackColor       =   &H00C0C0C0&
  111.          Caption         =   "Jet (Attached)"
  112.          Height          =   255
  113.          Index           =   3
  114.          Left            =   120
  115.          TabIndex        =   13
  116.          Top             =   840
  117.          Width           =   1530
  118.       End
  119.    End
  120.    Begin CommandButton cmdTest 
  121.       Cancel          =   -1  'True
  122.       Caption         =   "Test All"
  123.       Enabled         =   0   'False
  124.       Height          =   495
  125.       Left            =   7770
  126.       TabIndex        =   7
  127.       Top             =   90
  128.       Width           =   855
  129.    End
  130.    Begin ComboBox cboPreBuilt 
  131.       FontBold        =   -1  'True
  132.       FontItalic      =   0   'False
  133.       FontName        =   "MS Sans Serif"
  134.       FontSize        =   9.75
  135.       FontStrikethru  =   0   'False
  136.       FontUnderline   =   0   'False
  137.       Height          =   360
  138.       Left            =   1440
  139.       Style           =   2  'Dropdown List
  140.       TabIndex        =   6
  141.       Top             =   120
  142.       Width           =   4455
  143.    End
  144.    Begin ListBox lstResults 
  145.       FontBold        =   -1  'True
  146.       FontItalic      =   0   'False
  147.       FontName        =   "MS Sans Serif"
  148.       FontSize        =   9.75
  149.       FontStrikethru  =   0   'False
  150.       FontUnderline   =   0   'False
  151.       Height          =   1710
  152.       Left            =   120
  153.       TabIndex        =   4
  154.       Top             =   4200
  155.       Width           =   8895
  156.    End
  157.    Begin TextBox txtSQL 
  158.       FontBold        =   -1  'True
  159.       FontItalic      =   0   'False
  160.       FontName        =   "MS Sans Serif"
  161.       FontSize        =   9.75
  162.       FontStrikethru  =   0   'False
  163.       FontUnderline   =   0   'False
  164.       Height          =   1335
  165.       Left            =   1440
  166.       MultiLine       =   -1  'True
  167.       ScrollBars      =   2  'Vertical
  168.       TabIndex        =   3
  169.       Top             =   480
  170.       Width           =   4455
  171.    End
  172.    Begin CommandButton cmdExecute 
  173.       Caption         =   "Test Only:"
  174.       Enabled         =   0   'False
  175.       Height          =   495
  176.       Left            =   6015
  177.       TabIndex        =   2
  178.       Top             =   105
  179.       Width           =   1200
  180.    End
  181.    Begin CommandButton cmdLogoff 
  182.       Caption         =   "Logoff"
  183.       Enabled         =   0   'False
  184.       Height          =   495
  185.       Left            =   120
  186.       TabIndex        =   1
  187.       Top             =   720
  188.       Width           =   1215
  189.    End
  190.    Begin CommandButton cmdLogon 
  191.       Caption         =   "Logon"
  192.       Default         =   -1  'True
  193.       Height          =   495
  194.       Left            =   120
  195.       TabIndex        =   0
  196.       Top             =   120
  197.       Width           =   1215
  198.    End
  199.    Begin VBSQL VBSQL1 
  200.       Caption         =   "VBSQL1"
  201.       Height          =   255
  202.       Left            =   0
  203.       Top             =   0
  204.       Visible         =   0   'False
  205.       Width           =   255
  206.    End
  207.    Begin ListBox lstMsgs 
  208.       FontBold        =   -1  'True
  209.       FontItalic      =   0   'False
  210.       FontName        =   "MS Sans Serif"
  211.       FontSize        =   9.75
  212.       FontStrikethru  =   0   'False
  213.       FontUnderline   =   0   'False
  214.       Height          =   2190
  215.       Left            =   120
  216.       TabIndex        =   5
  217.       Top             =   1920
  218.       Width           =   8895
  219.    End
  220.    Begin Label Label1 
  221.       BackColor       =   &H00000000&
  222.       BackStyle       =   0  'Transparent
  223.       Caption         =   "x"
  224.       Height          =   225
  225.       Left            =   8700
  226.       TabIndex        =   20
  227.       Top             =   255
  228.       Width           =   195
  229.    End
  230.    Begin Label lblClipData 
  231.       Caption         =   "lblClipdata"
  232.       Height          =   255
  233.       Left            =   7440
  234.       TabIndex        =   16
  235.       Top             =   6000
  236.       Visible         =   0   'False
  237.       Width           =   1695
  238.    End
  239.    Begin Label lblStatus 
  240.       BackColor       =   &H00C0C0C0&
  241.       FontBold        =   0   'False
  242.       FontItalic      =   0   'False
  243.       FontName        =   "MS Sans Serif"
  244.       FontSize        =   8.25
  245.       FontStrikethru  =   0   'False
  246.       FontUnderline   =   0   'False
  247.       Height          =   255
  248.       Left            =   0
  249.       TabIndex        =   8
  250.       Top             =   6000
  251.       Width           =   7455
  252.    End
  253. Option Explicit
  254. ' Time Counters
  255. Dim lExecTime As Long, lFetchTime As Long
  256. ' VBSQL SQL Connection Handle
  257. Dim iSQLConn As Integer
  258. ' ODBC API Enviornment, Database, and Statement Handles
  259. Dim henv As Long
  260. Dim hdbc As Long
  261. Dim hstmt As Long
  262. ' VB ODBC (Jet) Database Object
  263. Dim gDB As Database
  264. ' Access Attached Table Database Object
  265. Dim gDBAttached As Database
  266. ' Access Local Database Object
  267. Dim gDBAccess As Database
  268. ' Constants for Option Button Indexes
  269. Const DBLIB_INDEX% = 0
  270. Const ODBC_INDEX% = 1
  271. Const JET_INDEX% = 2
  272. Const ATTACHED_INDEX% = 3
  273. Const ACCESS_INDEX% = 4
  274. ' Used for timing...
  275. Declare Function GetTickCount Lib "User" () As Long
  276. Sub Attempt (ResultCode As Integer, ErrorMessage As String)
  277.   ' If ResultCode <> SQL_SUCCESS, then bomb out
  278.   If ResultCode <> SQL_SUCCESS Then
  279.     lstMsgs.AddItem Format$(ResultCode) & " - " & ErrorMessage
  280.     Stop
  281.   End If
  282. End Sub
  283. Sub cboPreBuilt_Click ()
  284.     Select Case cboPreBuilt.ListIndex
  285.         Case 0
  286.             txtSQL.Text = Q1_1 & Q1_2 & Q1_3 & Q1_4 & Q1_5
  287.         Case 1
  288.             txtSQL.Text = Q2_1 & Q2_2 & Q2_3 & Q2_4 & Q2_5
  289.         Case 2
  290.             txtSQL.Text = Q3_1 & Q3_2 & Q3_3 & Q3_4 & Q3_5
  291.         Case 3
  292.             txtSQL.Text = Q4_1 & Q4_2 & Q4_3 & Q4_4 & Q4_5
  293.     End Select
  294. End Sub
  295. Sub cmdExecute_Click ()
  296.     Dim sMode As String
  297.     Dim db As Database
  298.     MousePointer = 11
  299.     lstResults.Clear
  300.     Select Case Val(fraMethod.Tag)
  301.         Case DBLIB_INDEX
  302.             sMode = "VBSQL"
  303.             lblStatus.Caption = "Executing via " & sMode & "..."
  304.             DoEvents
  305.             Call ExecViaDBLib((txtSQL.Text))
  306.         Case ODBC_INDEX
  307.             sMode = "ODBC API"
  308.             lblStatus.Caption = "Executing via " & sMode & "..."
  309.             DoEvents
  310.             Call ExecViaODBC((txtSQL.Text))
  311.         Case JET_INDEX, ATTACHED_INDEX
  312.             If Val(fraMethod.Tag) = JET_INDEX Then
  313.                 sMode = "Jet"
  314.                 Set db = gDB
  315.             Else
  316.                 sMode = "Jet Attached"
  317.                 Set db = gDBAttached
  318.             End If
  319.             sMode = sMode & IIf(chkPassthru.Value, " w/ Passthru", "")
  320.             sMode = sMode & IIf(optSnapshot.Value, " Snapshot", " Dynaset")
  321.             lblStatus.Caption = "Executing via " & sMode & "..."
  322.             DoEvents
  323.             If optSnapshot.Value Then
  324.                 Call ExecViaJetSnapshot(db, (txtSQL.Text), chkPassthru.Value = 1)
  325.             Else
  326.                 Call ExecViaJetDynaset(db, (txtSQL.Text))
  327.             End If
  328.     End Select
  329.     lstMsgs.AddItem Format(lExecTime, "0") & " milliseconds to execute query via " & sMode
  330.     lstMsgs.AddItem Format(lFetchTime, "0") & " milliseconds to fetch results and add to list"
  331.     lblStatus.Caption = ""
  332.     MousePointer = 0
  333. End Sub
  334. Sub cmdExit_Click ()
  335.   If cmdLogoff.Enabled Then
  336.     Call cmdLogoff_Click
  337.   End If
  338.   Unload frmPerfTest
  339. End Sub
  340. Sub cmdLogoff_Click ()
  341.     ' Logoff VBSQL...
  342.     If iSQLConn <> 0 Then SqlClose iSQLConn
  343.     lstMsgs.AddItem "Closed VBSQL Connection"
  344.     ' Logoff ODBC...
  345.     If hstmt <> 0 Then Attempt SQLFreeStmt(hstmt, 0), "Unable to free statment handle"
  346.     If hdbc <> 0 Then Attempt SQLDisconnect(hdbc), "Unable to disconnect"
  347.     If hdbc <> 0 Then Attempt SQLFreeConnect(hdbc), "Unable to free connection handle"
  348.     lstMsgs.AddItem "Freed ODBC Connection"
  349.     ' Logoff Jet...
  350.     gDB.Close
  351.     lstMsgs.AddItem "Closed Jet Database"
  352.     ' Logoff Attached...
  353.     gDBAttached.Close
  354.     lstMsgs.AddItem "Closed Attached Table Database"
  355.     ' Logoff Jet...
  356.     'gDBAccess.Close
  357.     'lstMsgs.AddItem "Closed Local Access Database"
  358.     Clipboard.SetText lblClipData.Caption
  359.     lblClipData.Caption = ""
  360.     cmdExecute.Enabled = False
  361.     cmdTest.Enabled = False
  362.     cmdLogon.Enabled = True
  363.     cmdLogoff.Enabled = False
  364. End Sub
  365. Sub cmdLogon_Click ()
  366.     Dim iRC As Integer
  367.     Dim sConnect As String
  368.     Dim sConnectBuffer As String
  369.     Dim ilenConnect As Integer
  370.     Dim lTicksStart As Long, lTicksStop As Long
  371.     Dim sClipData As String
  372.     ' Start keeping track of stats in label...
  373.     lblClipData.Caption = "Task" & Chr$(9) & "VBSQL" & Chr$(9) & "ODBC API" & Chr$(9) & "Jet w/ Passthru" & Chr$(9) & "Jet SS" & Chr$(9) & "Jet DS" & Chr$(9) & "Attached SS" & Chr$(9) & "Attached DS" & Chr$(9) & "Access SS" & Chr$(9)
  374.     lblClipData.Caption = lblClipData.Caption & "Access DS" & Chr$(13) & Chr$(10) & "Logon" & Chr$(9)
  375.     MousePointer = 11
  376.     ' Logon via VBSQL
  377.     lblStatus.Caption = "Logging on via VBSQL..."
  378.     DoEvents
  379.     lTicksStart = GetTickCount()
  380.     iSQLConn = SqlOpenConnection(SERVER, USERNAME, PASSWORD, HOSTNAME, APPNAME)
  381.     iRC = SqlUse(iSQLConn, DBNAME)
  382.     lTicksStop = GetTickCount()
  383.     lstMsgs.AddItem Format(lTicksStop - lTicksStart, "#") & " milliseconds to logon via VBSQL"
  384.     lblClipData.Caption = lblClipData.Caption & Format(lTicksStop - lTicksStart, "#") & Chr$(9)
  385.     ' Logon via ODBC API...
  386.     lblStatus.Caption = "Logging on via ODBC..."
  387.     DoEvents
  388.     lTicksStart = GetTickCount()
  389.     iRC = SQLAllocConnect(henv, hdbc)
  390.     If iRC <> SQL_SUCCESS Then
  391.         MsgBox "Can't allocate ODBC connection handle.", 16
  392.         Stop
  393.     Else
  394.         sConnect = "DSN=" & DSN & ";UID=" & USERNAME & ";PWD=" & PASSWORD & ";DATABASE=" & DBNAME
  395.         sConnect = sConnect & ";WSID=" & HOSTNAME & ";APP=" & APPNAME
  396.         sConnectBuffer = Space$(256)
  397.         iRC = SQLDriverConnect(hdbc, Me.hWnd, sConnect, Len(sConnect), sConnectBuffer, Len(sConnectBuffer), ilenConnect, SQL_DRIVER_NOPROMPT)
  398.         If iRC <> SQL_SUCCESS And iRC <> SQL_SUCCESS_WITH_INFO Then
  399.             DescribeError hdbc, 0
  400.             Stop
  401.         Else
  402.             If iRC = SQL_SUCCESS_WITH_INFO Then DescribeError hdbc, 0
  403.             iRC = SQLAllocStmt(hdbc, hstmt)
  404.             If iRC <> SQL_SUCCESS Then
  405.                 MsgBox "Cannot allocate statment handle", 16
  406.                 Stop
  407.             End If
  408.         End If
  409.     End If
  410.     lTicksStop = GetTickCount()
  411.     lstMsgs.AddItem Format(lTicksStop - lTicksStart, "#") & " milliseconds to logon via ODBC API"
  412.     ' Add the following line back to use asynchronous calls to SQLExecDirect - see also ExecViaODBC
  413.     ' Attempt SQLSetStmtOption(hstmt, SQL_ASYNC_ENABLE, 1&), "Can't set Async on"
  414.     lblClipData.Caption = lblClipData.Caption & Format(lTicksStop - lTicksStart, "#") & Chr$(9)
  415.     ' Logon via VB ODBC (Jet)...
  416.     lblStatus.Caption = "Logging on via Jet..."
  417.     DoEvents
  418.     lTicksStart = GetTickCount()
  419.     sConnect = "ODBC;"
  420.     sConnect = sConnect & "DSN=" & DSN & ";UID=" & USERNAME & ";PWD=" & PASSWORD & ";DATABASE=" & DBNAME
  421.     sConnect = sConnect & ";WSID=" & HOSTNAME & ";APP=" & APPNAME
  422.     Set gDB = OpenDatabase("", False, True, sConnect)
  423.     lTicksStop = GetTickCount()
  424.     lstMsgs.AddItem Format(lTicksStop - lTicksStart, "#") & " milliseconds to logon via Jet"
  425.     lblClipData.Caption = lblClipData.Caption & Format(lTicksStop - lTicksStart, "#") & Chr$(9)
  426.     lblClipData.Caption = lblClipData.Caption & Format(lTicksStop - lTicksStart, "#") & Chr$(9)
  427.     lblClipData.Caption = lblClipData.Caption & Format(lTicksStop - lTicksStart, "#") & Chr$(9)
  428.     ' Logon to Access Attached Table Database...
  429.     lblStatus.Caption = "Logging on to Access Attached Tables Database..."
  430.     DoEvents
  431.     lTicksStart = GetTickCount()
  432.     ' This is an Access MDB with attached table connections to the same
  433.     ' SQL Server tables...
  434.     Set gDBAttached = OpenDatabase(JETDB, False, True)
  435.     lTicksStop = GetTickCount()
  436.     lstMsgs.AddItem Format(lTicksStop - lTicksStart, "#") & " milliseconds to logon to Access Attached Tables Database"
  437.     lblClipData.Caption = lblClipData.Caption & Format(lTicksStop - lTicksStart, "#") & Chr$(9)
  438.     lblClipData.Caption = lblClipData.Caption & Format(lTicksStop - lTicksStart, "#") & Chr$(9)
  439.     lblClipData.Caption = lblClipData.Caption & Chr$(13) & Chr$(10)
  440.     lblStatus.Caption = ""
  441.     MousePointer = 0
  442.     cmdExecute.Enabled = True
  443.     cmdTest.Enabled = True
  444.     cmdLogon.Enabled = False
  445.     cmdLogoff.Enabled = True
  446. End Sub
  447. Sub cmdTest_Click ()
  448.     Dim iCount As Integer
  449.     Dim lExecSum As Long
  450.     Dim lFetchSum As Long
  451.     Dim iNum As Integer
  452.     iNum = Val(txtIterations.Text)
  453.     If iNum < 1 Or iNum > 9 Then Exit Sub
  454.     MousePointer = 11
  455.     lblClipData.Caption = lblClipData.Caption & txtSQL.Text & Chr$(9)
  456. DBLib:
  457.     For iCount = 1 To iNum
  458.         lblStatus.Caption = "Executing VBSQL Iteration" & Str$(iCount)
  459.         lstResults.Clear
  460.         DoEvents
  461.         Call ExecViaDBLib((txtSQL.Text))
  462.         lExecSum = lExecSum + lExecTime
  463.         lFetchSum = lFetchSum + lFetchTime
  464.     Next iCount
  465.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via VBSQL"
  466.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  467.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  468.     lExecSum = 0
  469.     lFetchSum = 0
  470. ODBC:
  471.     For iCount = 1 To iNum
  472.         lblStatus.Caption = "Executing ODBC API Iteration" & Str$(iCount)
  473.         lstResults.Clear
  474.         DoEvents
  475.         Call ExecViaODBC((txtSQL.Text))
  476.         lExecSum = lExecSum + lExecTime
  477.         lFetchSum = lFetchSum + lFetchTime
  478.     Next iCount
  479.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via ODBC API"
  480.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  481.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  482. JetPassthru:
  483.     For iCount = 1 To iNum
  484.         lblStatus.Caption = "Executing Jet Passthru Iteration" & Str$(iCount)
  485.         lstResults.Clear
  486.         DoEvents
  487.         Call ExecViaJetSnapshot(gDB, (txtSQL.Text), True)
  488.         lExecSum = lExecSum + lExecTime
  489.         lFetchSum = lFetchSum + lFetchTime
  490.     Next iCount
  491.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via Jet Passthru"
  492.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  493.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  494.     lExecSum = 0
  495.     lFetchSum = 0
  496. JetSnapshot:
  497.     For iCount = 1 To iNum
  498.         lblStatus.Caption = "Executing Jet Snapshot Iteration" & Str$(iCount)
  499.         lstResults.Clear
  500.         DoEvents
  501.         Call ExecViaJetSnapshot(gDB, (txtSQL.Text), False)
  502.         lExecSum = lExecSum + lExecTime
  503.         lFetchSum = lFetchSum + lFetchTime
  504.     Next iCount
  505.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via Jet Snapshot"
  506.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  507.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  508.     lExecSum = 0
  509.     lFetchSum = 0
  510. JetDynaset:
  511.     For iCount = 1 To iNum
  512.         lblStatus.Caption = "Executing Jet Dynaset Iteration" & Str$(iCount)
  513.         lstResults.Clear
  514.         DoEvents
  515.         Call ExecViaJetDynaset(gDB, (txtSQL.Text))
  516.         lExecSum = lExecSum + lExecTime
  517.         lFetchSum = lFetchSum + lFetchTime
  518.     Next iCount
  519.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via Jet Dynaset"
  520.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  521.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  522.     lExecSum = 0
  523.     lFetchSum = 0
  524. AttachedSnapshot:
  525.     For iCount = 1 To iNum
  526.         lblStatus.Caption = "Executing Attached Snapshot Iteration" & Str$(iCount)
  527.         lstResults.Clear
  528.         DoEvents
  529.         Call ExecViaJetSnapshot(gDBAttached, (txtSQL.Text), False)
  530.         lExecSum = lExecSum + lExecTime
  531.         lFetchSum = lFetchSum + lFetchTime
  532.     Next iCount
  533.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via Attached Snapshot"
  534.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  535.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  536.     lExecSum = 0
  537.     lFetchSum = 0
  538. AttachedDynaset:
  539.     For iCount = 1 To iNum
  540.         lblStatus.Caption = "Executing Attached Dynaset Iteration" & Str$(iCount)
  541.         lstResults.Clear
  542.         DoEvents
  543.         Call ExecViaJetDynaset(gDBAttached, (txtSQL.Text))
  544.         lExecSum = lExecSum + lExecTime
  545.         lFetchSum = lFetchSum + lFetchTime
  546.     Next iCount
  547.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via Attached Dynaset"
  548.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  549.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  550.     lExecSum = 0
  551.     lFetchSum = 0
  552.     GoTo TestExit
  553.     lstMsgs.AddItem Format(lExecSum / iNum, "0") & " average milliseconds to execute query via Access Dynaset"
  554.     lstMsgs.AddItem Format(lFetchSum / iNum, "0") & " average milliseconds to fetch results and add to list"
  555.     lblClipData.Caption = lblClipData.Caption & Format(((lExecSum / iNum) + (lFetchSum / iNum)), "0") & Chr$(9)
  556.     lExecSum = 0
  557.     lFetchSum = 0
  558. TestExit:
  559.     lblClipData.Caption = lblClipData.Caption & Chr$(13) & Chr$(10)
  560.     lblStatus.Caption = "Done."
  561.     Beep
  562.     MousePointer = 0
  563. End Sub
  564. Sub DescribeError (ByVal hdbc As Long, ByVal hstmt As Long)
  565.   ' Print an error message for the given connection handle
  566.   ' and statement handle
  567.   Dim sBuffer1 As String * 16
  568.   Dim sBuffer2 As String * 256
  569.   Dim iOutLen As Integer
  570.   Dim lNative As Long
  571.   Dim iRC As Integer
  572.   sBuffer1 = String$(16, 0)
  573.   sBuffer2 = String$(256, 0)
  574.     iRC = SQLError(0, hdbc, hstmt, sBuffer1, lNative, sBuffer2, 256, iOutLen)
  575.     If iRC = SQL_SUCCESS Or iRC = SQL_SUCCESS_WITH_INFO Then
  576.         If iOutLen = 0 Then
  577.             lstMsgs.AddItem "Error -- No error information available"
  578.             Stop
  579.         Else
  580.             lstMsgs.AddItem Format$(lNative) & " - " & Left$(sBuffer2, iOutLen)
  581.         End If
  582.     End If
  583.   Loop Until iRC <> SQL_SUCCESS
  584. End Sub
  585. Sub ExecViaDBLib (sSQL As String)
  586.     Dim rc As Integer
  587.     Dim iCount As Integer
  588.     Dim sStuff As String
  589.     Dim lTicksStart As Long, lTicksStop As Long
  590.     lTicksStart = GetTickCount()
  591.     If SqlCmd(iSQLConn, sSQL) = FAIL Then Exit Sub
  592.     If SqlExec(iSQLConn) = FAIL Then Exit Sub
  593.     lTicksStop = GetTickCount()
  594.     lExecTime = lTicksStop - lTicksStart
  595.     lTicksStart = GetTickCount()
  596.     Do While SqlResults(iSQLConn) <> NOMORERESULTS
  597.         Do While SqlNextRow(iSQLConn) <> NOMOREROWS
  598.             sStuff = ""
  599.             For iCount = 1 To SqlNumCols(iSQLConn)
  600.                 sStuff = sStuff & SqlData(iSQLConn, iCount) & Chr$(9)
  601.             Next iCount
  602.             lstResults.AddItem sStuff
  603.         Loop
  604.     Loop
  605.     lTicksStop = GetTickCount()
  606.     lFetchTime = lTicksStop - lTicksStart
  607.     lstResults.Refresh
  608. End Sub
  609. Sub ExecViaJetDynaset (db As Database, sSQL As String)
  610.     Dim ss As Dynaset
  611.     Dim rc As Integer
  612.     Dim iCount As Integer
  613.     Dim sStuff As String
  614.     Dim lTicksStart As Long, lTicksStop As Long
  615.     ' Comment out line below if you use passthru...
  616.     If Right(sSQL, 2) = "%'" Then Mid(sSQL, Len(sSQL) - 1, 2) = "*'"
  617.     lTicksStart = GetTickCount()
  618.     Set ss = db.CreateDynaset(sSQL)
  619.     lTicksStop = GetTickCount()
  620.     lExecTime = lTicksStop - lTicksStart
  621.     lTicksStart = GetTickCount()
  622.     Do While Not ss.EOF
  623.         sStuff = ""
  624.         For iCount = 0 To ss.Fields.Count - 1
  625.             sStuff = sStuff & ss(iCount) & Chr$(9)
  626.         Next iCount
  627.         lstResults.AddItem sStuff
  628.         ss.MoveNext
  629.     Loop
  630.     lTicksStop = GetTickCount()
  631.     lFetchTime = lTicksStop - lTicksStart
  632.     lstResults.Refresh
  633.     ss.Close
  634. End Sub
  635. Sub ExecViaJetSnapshot (db As Database, sSQL As String, fPassThru As Integer)
  636.     Dim ss As snapshot
  637.     Dim rc As Integer
  638.     Dim iCount As Integer
  639.     Dim sStuff As String
  640.     Dim lTicksStart As Long, lTicksStop As Long
  641.     Dim iPassThrough As Integer
  642.     If fPassThru Then iPassThrough = 64 Else iPassThrough = 0
  643.     ' Comment out line below if you use passthru...
  644.     If Right(sSQL, 2) = "%'" Then Mid(sSQL, Len(sSQL) - 1, 2) = "*'"
  645.     lTicksStart = GetTickCount()
  646.     Set ss = db.CreateSnapshot(sSQL, iPassThrough)
  647.     lTicksStop = GetTickCount()
  648.     lExecTime = lTicksStop - lTicksStart
  649.     lTicksStart = GetTickCount()
  650.     Do While Not ss.EOF
  651.         sStuff = ""
  652.         For iCount = 0 To ss.Fields.Count - 1
  653.             sStuff = sStuff & ss(iCount) & Chr$(9)
  654.         Next iCount
  655.         lstResults.AddItem sStuff
  656.         ss.MoveNext
  657.     Loop
  658.     lTicksStop = GetTickCount()
  659.     lFetchTime = lTicksStop - lTicksStart
  660.     lstResults.Refresh
  661.     ss.Close
  662. End Sub
  663. Sub ExecViaODBC (sQuery As String)
  664.     Dim lOutLen As Long
  665.     Dim iCount As Integer
  666.     Dim iNumCols As Integer
  667.     Dim iRC As Integer
  668.     Const iBufferLen% = 256
  669.     Dim sBuffer As String * iBufferLen
  670.     Dim sStuff As String
  671.     Dim lTicksStart As Long, lTicksStop As Long
  672.     lTicksStart = GetTickCount()
  673.     iRC = SQLExecDirect(hstmt, sQuery, Len(sQuery))
  674. ' Add the following lines back to allow asynchronous execution
  675. '    Do While iRC = SQL_STILL_EXECUTING
  676. '        DoEvents
  677. '        iRC = SQLExecDirect(hstmt, sQuery, Len(sQuery))
  678. '    Loop
  679.     lTicksStop = GetTickCount()
  680.     lExecTime = lTicksStop - lTicksStart
  681.     If iRC <> SQL_SUCCESS Then
  682.         DescribeError hdbc, hstmt
  683.         Exit Sub
  684.     End If
  685.     lTicksStart = GetTickCount()
  686.     iRC = SQLNumResultCols(hstmt, iNumCols)
  687.     If iRC <> SQL_SUCCESS Then
  688.         DescribeError hdbc, hstmt
  689.         Exit Sub
  690.     End If
  691.     Do While SQLFetch(hstmt) = SQL_SUCCESS
  692.         sStuff = ""
  693.         For iCount = 1 To iNumCols
  694.             Attempt SQLGetData(hstmt, iCount, 1, sBuffer, iBufferLen, lOutLen), "Call to SQLGetData Failed"
  695.             If lOutLen = -1 Then
  696.                 sStuff = sStuff & "NULL" & Chr$(9)
  697.             Else
  698.                 sStuff = sStuff & Left$(sBuffer, lOutLen) & Chr$(9)
  699.             End If
  700.         Next iCount
  701.         lstResults.AddItem sStuff
  702.     Loop
  703.     lTicksStop = GetTickCount()
  704.     lFetchTime = lTicksStop - lTicksStart
  705.     lstResults.Refresh
  706.     Attempt SQLFreeStmt(hstmt, SQL_CLOSE), "FreeStmt Failed"
  707. End Sub
  708. Sub Form_Load ()
  709.     Dim sMsg As String, iRC As Integer
  710.     ' Initialize VBSQL...
  711.     sMsg = SqlInit()
  712.     If sMsg = "" Then
  713.         MsgBox "Can't initialize VBSQL environment.", 16
  714.         Stop
  715.     End If
  716.     ' Initialize ODBC...
  717.     iRC = SQLAllocEnv(henv)
  718.     If iRC <> SQL_SUCCESS Then
  719.         MsgBox "Can't allocate ODBC environment.", 16
  720.         Stop
  721.     End If
  722.     ' Fill combobox with descriptions of test queries
  723.     cboPreBuilt.AddItem Q1Name
  724.     cboPreBuilt.AddItem Q2Name
  725.     cboPreBuilt.AddItem Q3Name
  726.     cboPreBuilt.AddItem Q4Name
  727.     cboPreBuilt.ListIndex = 0
  728. End Sub
  729. Sub Form_Unload (Cancel As Integer)
  730.     ' Clean up from VBSQL...
  731.     If iSQLConn <> 0 Then
  732.         SqlWinExit
  733.         SqlExit
  734.     End If
  735.     ' Clean up ODBC
  736.     If henv <> 0 Then
  737.         Attempt SQLFreeEnv(henv), "Couldn't free ODBC environment"
  738.     End If
  739. End Sub
  740. Sub optMethod_Click (Index As Integer)
  741.     ' Keep track of selected option in frame's tag
  742.     fraMethod.Tag = CStr(Index)
  743.     ' Turn on/off appropriate options...
  744.     Select Case Index
  745.         Case DBLIB_INDEX
  746.             fraRecordset.Visible = False
  747.             chkPassthru.Visible = False
  748.         Case ODBC_INDEX
  749.             fraRecordset.Visible = False
  750.             chkPassthru.Visible = False
  751.         Case JET_INDEX
  752.             fraRecordset.Visible = True
  753.             chkPassthru.Visible = True
  754.         Case ATTACHED_INDEX
  755.             fraRecordset.Visible = True
  756.             chkPassthru.Visible = False
  757.             chkPassthru.Value = 0
  758.     End Select
  759. End Sub
  760. Sub txtIterations_Change ()
  761.     ' limit to one char (1-9)
  762.     If Len(txtIterations.Text) > 1 Then
  763.         txtIterations.Text = Right(txtIterations.Text, 1)
  764.         Beep
  765.     End If
  766. End Sub
  767. Sub txtIterations_KeyPress (KeyAscii As Integer)
  768.     ' Only allow numbers 1-9...
  769.     If KeyAscii < 49 Or KeyAscii > 57 Then KeyAscii = 0
  770. End Sub
  771. Sub VBSQL1_Error (SqlConn As Integer, Severity As Integer, ErrorNum As Integer, ErrorStr As String, RetCode As Integer)
  772.     lstMsgs.AddItem CStr(ErrorNum) & " - " & ErrorStr
  773. End Sub
  774. Sub VBSQL1_Message (SqlConn As Integer, Message As Long, State As Integer, Severity As Integer, MsgStr As String)
  775.     lstMsgs.AddItem CStr(Message) & " - " & MsgStr
  776. End Sub
  777.